home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / security / tcpr-1.1.5 / tcprelay.pl < prev    next >
Encoding:
Text File  |  1993-03-23  |  11.3 KB  |  430 lines
  1. #
  2. # File:        tcprelay.pl
  3. # Author:    Kazumasa Utashiro
  4. # Modified:    G. Paul Ziemba
  5. # From:        tcprelay,v 1.2 1992/04/13 19:10:28 utashiro
  6. # Date:        93.01.25
  7. # SCCS:        @(#)tcprelay.pl    1.7 3/2/93
  8. # Purpose:    application-level tcp stream relay; handles ftp, too.
  9. #
  10. ;#
  11. ;# tcprelay: application level tcp bridge
  12. ;#
  13. ;# Copyright (c) 1990,1991,1992 Kazumasa Utashiro
  14. ;# Software Research Associates, Inc., Japan <utashiro@sra.co.jp>
  15. ;#
  16. ;# Version 1.0, Oct 29 1990
  17. ;# Version 1.1, Jan 21 1991
  18. ;; $rcsid = '$Id: tcprelay,v 1.2 1992/04/13 19:10:28 utashiro Exp $';#'
  19. ;#
  20. ;# Usage:
  21. ;#    tcprelay [switches] servername clientname [service]
  22. ;#      tcprelay [switches] -i
  23. ;#
  24. ;# Switches:
  25. ;#    -fg:    force foregound
  26. ;#    -bg:    force backgound [default]
  27. ;#    -ftp:    force ftp mode (automatically on when connecting to ftp port)
  28. ;#
  29. ;# Description:
  30. ;#    This program relays tcp connection in application layer, which
  31. ;#    is useful when connecting across the IP disjoint gateway.
  32. ;#    Tcprelay connect to specified server and then makes local port
  33. ;#    and listen for connection from the client.  After tcprelay listen,
  34. ;#    anybody can connect to that port, so client name is required
  35. ;#    to avoid unexpected connect request.  Local port number is not
  36. ;#    explicitly defined, so you have to see message from tcprelay
  37. ;#    and invoke internet command with that number on client machine.
  38. ;#
  39. ;#        --------   ----|----   --------
  40. ;#        |client|---|gateway|---|server|
  41. ;#        --------   ----|----   --------
  42. ;#
  43. ;#    If the session seems to be ftp, tcprelay fakes PORT command
  44. ;#    in ftp interaction.  It makes connection to port in CLIENT which
  45. ;#    is specified in PORT command, and makes local socket to listen from
  46. ;#    ftp SERVER and returns that local port number to SERVER instead of
  47. ;#    the number sent from ftp CLIENT.  Use -ftp option when you want to
  48. ;#    connect to ftpd which doesn't have standard port number 21.
  49. ;#
  50. ;#    Default service is ftp, because this program is made for doing
  51. ;#    ftp originaly.
  52. ;#
  53. ;# Example:
  54. ;#    1) % tcprelay server client    : on gateway
  55. ;#       port=xxxx            : remember port number in message
  56. ;#    2) % ftp gateway xxxx        : on client
  57. ;#
  58. ;# require 'sys/socket.ph';
  59. unless (do 'sys/socket.ph') {
  60.     eval 'sub SOCK_STREAM {1;} sub AF_INET {2;} sub PF_INET {2;}';
  61. }
  62.  
  63. if ($> == 0) {
  64.     #
  65.     # Shouldn't run as root!
  66.     #
  67.     $) = -2;
  68.     $( = -2;
  69.     $< = -2;
  70.     $> = -2;
  71. }
  72.  
  73. #
  74. # Default path unless specified in Makefile
  75. #
  76. $ENV{'PATH'} = "/bin:/usr/bin:/etc:/usr/etc:/usr/ucb";
  77.  
  78. while ($_ = $ARGV[0], /^-/) {
  79.     shift;
  80.     if (/-s$/)        {$silent = 1;        next;}
  81. #    if (/-i$/)        {$interactive = 1;    next;}
  82.     if (/-ftp$/)    {$ctype = 'ftp';    next;}
  83.     if (/-d(\d*)$/)    {$debug = $1||1;    next;}
  84.     if (/-(fg|bg)$/)    {$fg = $1 eq 'fg';    next;}
  85.     &usage;
  86. }
  87. $progname = $0;
  88. $progname =~ s:.*/::g;
  89. $| = 1;
  90. if ($interactive) {
  91.     print "Enter server name or address: "; chop($servername=<>);
  92.     print "Enter client name or address: "; chop($clientname=<>);
  93. } else {
  94.     if ($#ARGV < $[+1) {&usage;}
  95.     ($servername, $clientname, $serverport, $localport) = @ARGV;
  96. }
  97. sub usage {
  98.     print "900 $0: Usage\n";
  99.     ($myname = $0) =~ s|.*/||;
  100.     print "Usage: $myname server client, or $myname -i\n";
  101.     print "$rcsid\n" if $rcsid =~ /:/;
  102.     exit(1);
  103. }
  104.  
  105. $sockaddr='S n a4 x8';
  106. ($name, $aliases, $TCP) = getprotobyname('tcp');
  107. $serverport='ftp' unless $serverport;
  108.  
  109. chop($localname = `hostname`);
  110. ($name, $aliases, $type, $len, $localaddr) = gethostbyname($localname);
  111.  
  112. ($serveraddr = &getaddr($servername)) || die "Unknown server $servername.\n";
  113. ($clientaddr = &getaddr($clientname)) || die "Unknown client $clientname.\n";
  114. ($name, $aliases, $serverport) =
  115.     getservbyname($serverport, 'tcp') unless $serverport =~ /^\d+$/;
  116. if (!defined($ctype)) {
  117.     if ($serverport == 21) {$ctype = 'ftp';}
  118.     else {$ctype = 'something';}
  119. }
  120. $masterpid=$$;
  121. $SIG{'HUP'}=$SIG{'INT'}=$SIG{'QUIT'}=$SIG{'TERM'}='terminate';
  122. sub terminate {kill -15, $masterpid; exit(1);}
  123. $SIG{'ALRM'} = 'IGNORE';
  124.  
  125. &relay($ctype, $serveraddr, $serverport);
  126.  
  127. sub relay {
  128.     local($type, $serveraddr, $serverport, $newport)=@_;
  129.     local($toplevel) = ($$ eq $masterpid);
  130.  
  131.     #
  132.     # server connection
  133.     # TBD - probably should time out here
  134.     #
  135.     $this = pack($sockaddr, &AF_INET, 0, $localaddr);
  136.     $that = pack($sockaddr, &AF_INET, $serverport, $serveraddr);
  137.     socket(S1, &PF_INET, &SOCK_STREAM, $TCP) || die "socket: $!";
  138. #    bind(S1, $this) || die "bind: $!";
  139.     connect(S1, $that) || die "connect: $!";
  140.     select(S1); $| = 1; select(stdout);
  141.  
  142.     &logit( ($toplevel? "900 C": "920 Slave c") .
  143.     "onnected to server " . join('.', unpack('C4', $serveraddr)));
  144.     &logit("900 Connection type is ftp\n") if ($type eq 'ftp');
  145.  
  146.     #
  147.     # client connection
  148.     #
  149.     $this = pack($sockaddr, &AF_INET, $localport, "\0\0\0\0");
  150.     $localport = 0;
  151.     socket(A1, &PF_INET, &SOCK_STREAM, $TCP) || die "socket: $!\n";
  152.     bind(A1, $this) || die "bind: $!\n";
  153.     listen(A1, 1) || die "listen: $!\n";
  154.     $newport = (unpack($sockaddr, getsockname(A1)))[1];
  155.     if (!$toplevel && !fork) {
  156.     close(S1); close(A1);
  157.     return($newport);
  158.     }
  159.     close(S), close(C) unless $toplevel;
  160.     open(S,"+>&S1"); close(S1);
  161.     open(A,"+>&A1"); close(A1);
  162.     printf "Please connect to port=%d\n", $newport if $toplevel;
  163.  
  164.     #
  165.     # time out here in case client has gone away
  166.     #
  167.     $SIG{'ALRM'} = 'client_timeout';
  168.     &alarm(180);
  169.     ($addr = accept(C, A)) || die "accept: $!\n";
  170.     &alarm(0);
  171.     close(A);
  172.  
  173.     ($af, $peerport, $peeraddr) = unpack($sockaddr, $addr);
  174.     if ($toplevel && $peeraddr ne $clientaddr) {
  175.     printf ("910 Connection from %s is not allowed!\n",
  176.         join('.', unpack('C4', $peeraddr)));
  177.     exit(1);
  178.     }
  179.     if ($toplevel) {
  180.         &logit(sprintf ("920 Connection from client %s\n",
  181.         join('.', unpack('C4', $peeraddr))));
  182.     }
  183.  
  184.     select(S); $| = 1; select(C); $| = 1; select(stdout);
  185.     if ($child = fork) {
  186.     if ($toplevel && !$fg && ($pid = fork)) {
  187.         &logit("900 Remote -> Client (pid = $pid)\n");
  188.         &logit("900 $$: exiting");
  189.         exit(0);
  190.     }
  191.     &forward('data', S, C, $serveraddr);
  192.     } else {
  193.     &logit("900 Client -> Remote (pid = $$)");
  194.     &forward($type, C, S, $serveraddr);    # serveraddr needed here
  195.     }
  196.     &logit("900 $$: exiting\n");
  197.     exit(0);
  198. }
  199.  
  200. sub forward {
  201.     local($type, $from, $to, $serveraddr) = @_;
  202.  
  203.     if ($type eq 'ftp') {
  204.     local($myportaddr) = &best_if_addr($serveraddr);
  205.  
  206.     &logit("900 (ftp) i/f to remote: " .
  207.         join('.', unpack('C4', $myportaddr)));
  208.  
  209.     while (<$from>) {
  210.         #
  211.         # Perhaps this match won't work sometimes if we get
  212.         # non-line chunks, since it's not line-buffered.
  213.         # Maybe this stream ought to be line buffered (?)
  214.         #
  215.         if (/^PORT ([\d,]+)/ && (@p = split(/,/, $1))) {
  216.         &logit("920 R PORT->$_");
  217.         $p = &relay('data', pack('C4', @p), $p[4]*256 + $p[5]);
  218.         #
  219.         # output in netascii (<stuff>\r\n)
  220.         #
  221.         $_ = sprintf("PORT %d,%d,%d,%d,%d,%d\r\n",
  222.                  unpack('C4', $myportaddr), $p/256, $p%256);
  223.         &logit("920 S PORT->$_");
  224.         }
  225.         print $to $_;
  226.     }
  227.     } else {
  228.     print $to $_ while(read($from, $_, 4096));
  229.     }
  230.     shutdown($from, 1); shutdown($to, 0);
  231. }
  232.  
  233. sub getaddr {
  234.     local($_) = @_;
  235.     /^[0-9\.]+$/ ? pack("C4", split(/\./)) : (gethostbyname($_))[4];
  236. }
  237.  
  238. #
  239. # find route to destination & return address of appropriate interface
  240. #
  241. sub best_if_addr { # remote addr
  242.     local($serveraddr) = $_[0];
  243.     local($server_dq) = sprintf("%d.%d.%d.%d", unpack('C4', $serveraddr));
  244.     local($OldPath, $NsProg);
  245.  
  246.     ($ENV{'PATH'}, $NsProg, $OldPath) = &pathit($NETSTATPATH, "netstat");
  247.  
  248.     open(RT, "$NsProg -rn|") || die "$NsProg: $!";
  249.     $ENV{'PATH'} = $OldPath;
  250.  
  251.     while (<RT>) {
  252.         split(?\s+?, $_);
  253.  
  254.         if (/^default/) {
  255.             $IfD = $_[5];
  256.         }
  257.         next if ($_[0] !~ /^([\d\.]+)$/);
  258.         $Dest = $_[0];
  259.  
  260.         next if ($_[2] !~ /U/);
  261.         if ($_[2] =~ /H/) {
  262.             ($GH{$Dest}, $IfH{$Dest}) = @_[1,5];
  263.         } else {
  264.             ($GN{$Dest}, $IfN{$Dest}) = @_[1,5];
  265.         }
  266.     }
  267.     close(RT);
  268.  
  269.     foreach (keys(%GH)) {
  270.         if ($_ eq $server_dq) {
  271.             &logit("900 Host route to $_: $GH{$_} via $IfH{$_}\n");
  272.             return &ifaddr($IfH{$_});
  273.         }
  274.     }
  275.     foreach (keys(%GN)) {
  276.         $_a = $_;
  277.  
  278.         s/(\.0)*$//;    # leave only net part
  279.         s/(\W)/\\$1/g;    # quote metacharacters
  280.  
  281.         if ($server_dq =~ /^$_/) {
  282.             &logit("900 Net route to $_a: $GN{$_a} via $IfN{$_a}\n");
  283.             return &ifaddr($IfN{$_a});
  284.         }
  285.     }
  286.     if (defined($IfD)) {
  287.         &logit("900 no Net or Host route, using default route: $IfD\n");
  288.         return &ifaddr($IfD);
  289.     }
  290.     &logit(sprintf("900 &bia: No Host, Net, or Default route, using %s\n",
  291.     join('.', unpack('C4', $localaddr))));
  292.     return $localaddr;
  293. }
  294.  
  295. sub ifaddr {    # ifname
  296.     local($ifname) = $_[0];
  297.     local($ip);
  298.     local($OldPath, $IfProg);
  299.  
  300.     ($ENV{'PATH'}, $IfProg, $OldPath) = &pathit($IFCONFIGPATH, "ifconfig");
  301.  
  302.     &logit("900 ifaddr: want IP-addr for: $ifname\n");
  303.     open (IFCONFIG, "$IfProg $ifname|") || die "ifconfig: $!";
  304.     $ENV{'PATH'} = $OldPath;
  305.     while (<IFCONFIG>) {
  306.         chop;
  307.         if (/\s+inet\s+(\S+)\s+/) {
  308.             $ip = $1;
  309.             last;
  310.         }
  311.     }
  312.     close(IFCONFIG);
  313.     if (!defined($ip)) {
  314.         local($dq) = join('.', unpack('C4', $localaddr));
  315.  
  316.         #
  317.         # This is a band-aid
  318.         #
  319.         &logit("900 ifaddr: can't parse ifconfig output, returning $dq\n");
  320.         return $localaddr;
  321.     }
  322.     return pack('C4', split(/\./, $ip));
  323. }
  324.  
  325. #
  326. # It's gross to do a fork for every message, but this
  327. # should only be needed for those occasional debugging
  328. # sessions :-)
  329. #
  330. sub logit {
  331.     local(@message) = split(/\n/, $_[0]);
  332.     local($kidpid, $_);
  333.  
  334.     return if (!$debug);
  335.  
  336.     for (@message) {
  337.         print STDERR "$_\n";
  338.         $_ = "[$$] " . $_;
  339.         $kidpid = fork;
  340.         if (!$kidpid) {
  341.             local($LogProg);
  342.             ($ENV{'PATH'}, $LogProg, $kidpid) =
  343.             &pathit($LOGGERPATH, "logger");
  344.  
  345.             exec $LogProg, "-t", $progname, "-p", "daemon.debug", $_;
  346.             exit -1;
  347.         } else {
  348.             waitpid($kidpid, 0);
  349.         }
  350.     }
  351. }
  352.  
  353. sub pathit { # Args: path it; Returns: NewPath, ProgName, OldPath
  354.     local($_, $it) = @_[0,1];
  355.     local(@retval);
  356.  
  357.     if (/./) {
  358.         if (!/:/) {
  359.             if (-d) {
  360.                 $_ .= "/$it";
  361.             }
  362.             @retval =  ("", $_, $ENV{'PATH'});
  363.             printf STDERR "[%s] [%s] [%s]\n", @retval[0..2];
  364.             return @retval;
  365.         }
  366.         @retval =  ($_, $it, $ENV{'PATH'});
  367.         printf STDERR "[%s] [%s] [%s]\n", @retval[0..2];
  368.         return @retval;
  369.     }
  370.     @retval = ($ENV{'PATH'}, $it, $ENV{'PATH'});
  371.     printf STDERR "[%s] [%s] [%s]\n", @retval[0..2];
  372.     return @retval;
  373. }
  374.  
  375. sub client_timeout {
  376.     &logit("900 client connection timed out. Exiting.");
  377.     &terminate;
  378. }
  379.  
  380. sub alarm {
  381.     local($timeout) = $_[0];
  382.  
  383.     &logit("alarm: called with $timeout");
  384.  
  385.     #
  386.     # If we forked, make sure we forget about alarm kid of parent
  387.     #
  388.     if ($CallerPid != $$) {
  389.         &logit("alarm: called first time in pid $$");
  390.         undef $AlarmPid;
  391.         $CallerPid = $$;
  392.     }
  393.  
  394.     #
  395.     # If we have an alarm kid, kill it
  396.     #
  397.     if (defined($AlarmPid)) {
  398.         &logit("alarm: killing ak $AlarmPid");
  399.         kill 'KILL', $AlarmPid;
  400.     }
  401.  
  402.     #
  403.     # Don't have to do anything else if zero timeout argument
  404.     #
  405.     if (!$timeout) {
  406.         return 0;
  407.     }
  408.  
  409.     $AlarmPid = fork;
  410.     if ($AlarmPid) {
  411.         return 0;
  412.     } elsif (!defined($AlarmPid)) {
  413.         #
  414.         # fork failed
  415.         # (is this the correct test for fork failure?)
  416.         #
  417.         &logit("alarm: fork failed");
  418.         return -1;
  419.     }
  420.  
  421.     #
  422.     # Child from here on
  423.     #
  424.     &logit("ak: sleeping for $timeout");
  425.     sleep($timeout);
  426.     &logit("ak: alarming $CallerPid");
  427.     kill 'ALRM', $CallerPid;
  428.     exit 0;
  429. }
  430.